home *** CD-ROM | disk | FTP | other *** search
/ Acorn RISC PD-CD 1 / Acorn RISC PD-CD 1.iso / languages / _tile / f83 / lists < prev    next >
Encoding:
Text File  |  1991-08-15  |  2.3 KB  |  128 lines
  1. \
  2. \  SINGLE LINKED LISTS
  3. \
  4. \  Copyright (C) 1990 by Mikael R.K. Patel
  5. \
  6. \  Computer Aided Design Laboratory (CADLAB)
  7. \  Department of Computer and Information Science
  8. \  Linkoping University
  9. \  S-581 83 LINKOPING
  10. \  SWEDEN
  11. \
  12. \  Email: mip@ida.liu.se
  13. \
  14. \  Started on: 1 May 1990
  15. \
  16. \  Last updated on: 19 June 1990
  17. \
  18. \  Dependencies:
  19. \       (forth) forth, blocks
  20. \
  21. \  Description:
  22. \       Management of single linked lists. Requires that the list
  23. \       structures have the link as the first field.
  24. \
  25. \  Copying:
  26. \       This program is free software; you can redistribute it and\or modify
  27. \       it under the terms of the GNU General Public License as published by
  28. \       the Free Software Foundation; either version 1, or (at your option)
  29. \       any later version.
  30. \
  31. \       This program is distributed in the hope that it will be useful,
  32. \       but WITHOUT ANY WARRANTY; without even the implied warranty of
  33. \       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  34. \       GNU General Public License for more details.
  35. \
  36. \       You should have received a copy of the GNU General Public License
  37. \       along with this program; see the file COPYING.  If not, write to
  38. \       the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 
  39.  
  40. .( Loading Lists definitions...) cr
  41.  
  42. #include <Tile$Lib>.blocks
  43.  
  44. vocabulary lists ( -- )
  45.  
  46. blocks lists definitions
  47.  
  48. : list ( -- )
  49.   create nil ,
  50. ;
  51.  
  52. : empty-list ( list -- )
  53.   nil swap !
  54. ;
  55.  
  56. : search-list ( element list -- [element last] or [false])
  57.   begin
  58.     2dup =
  59.     over @ 0= or not
  60.   while
  61.     @
  62.   repeat
  63.   dup @ if 2drop false then
  64. ; private
  65.  
  66. : append-list ( element list -- )
  67.   search-list ?dup if ! then
  68. ;
  69.  
  70. : insert-list ( element list -- )
  71.   2dup @ swap ! !
  72. ;
  73.  
  74. : size-list ( list -- num)
  75.   0 swap
  76.   begin
  77.     ?dup
  78.   while
  79.     swap 1+ swap @
  80.   repeat
  81. ;
  82.  
  83. : map-list ( list block[element -- ] -- )
  84.   >r
  85.   begin
  86.     ?dup
  87.   while
  88.     dup r@ swap >r
  89.     call
  90.     r> @
  91.   repeat
  92.   r> drop
  93. ;
  94.  
  95. : ?map-list ( list block[element -- bool] -- )
  96.   >r
  97.   begin
  98.     ?dup
  99.   while
  100.     dup r@ swap >r
  101.     call
  102.     if 2r> 2drop exit then
  103.     r> @
  104.   repeat
  105.   r> drop
  106. ;
  107.  
  108. : apply-list ( offset list -- )
  109.   begin
  110.     ?dup
  111.   while
  112.     2dup 2>r + @
  113.     execute
  114.     2r> @
  115.   repeat
  116.   drop
  117. ;
  118.  
  119. : ?member-list ( element list -- bool)
  120.   search-list if drop false else true then
  121. ;
  122.  
  123. : ?empty-list ( list -- bool)
  124.   0=
  125. ;
  126.  
  127. forth only
  128.